#!/usr/bin/perl -w

#########################################################################
# Set up the lib path using the expected environment variables.		#
#########################################################################

BEGIN {
        if(!exists($::ENV{TRUECL_CODE})) {
                die("Missing TRUECL_CODE environment variable.");
        }
        if(!exists($::ENV{TRUECL_LOG})) {
                die("Missing TRUECL_LOG environment variable.");
        }
        if(!exists($::ENV{TRUECL_CFG})) {
                die("Missing TRUECL_CFG environment variable.");
        }
	push @::INC,"$::ENV{TRUECL_CODE}/lib";
	$::_term_width=80;
	eval 'use Term::ReadKey; ($::_term_width)=GetTerminalSize();';
	$::_term_width=80 if $::_term_width<40
}

use strict;
use Carp;
use Carp qw(cluck);
use Getopt::Long;
use cllogging;
use File::Basename;
use Digest::SHA1 qw(sha1_hex);
use Sys::Hostname;
use Data::Dumper;
use cldb;
use clreq;
use Sys::Hostname;
use daemon_connect;
use clreqdxml;
use clutils qw(	map_select_output to_bool 
		get_clreqdxml_object get_clreqd_status);

$::_SPC=" " x length(basename($::0));
$::_PRG=basename($::0);

#########################################################################
# Default to using PKI encryption, unless specified otherwise or the	#
# required modules are not available.					#
#########################################################################

$::PKI=1;
eval "use Crypt::RSA;";
$::PKI=0 if $@;
if($::PKI==1 && exists($::ENV{TRUECL_PKI})) {
	$::PKI=$::ENV{TRUECL_PKI};
}

sub logit {
my $type=shift;
my $cline;
my $xx;

	confess("No log object defined.") if !defined($::LOGGER);
	for $cline (@_) {
		my @F=split(/\n/,$cline);
		for $xx (@F) {
			$::LOGGER->msg($type,$xx);
		}
	}
}

sub msg {
	logit("msg",@_);
}

sub warning {
	logit("warn",@_);
}

sub error {
my $rc;

	if(scalar(@_)>1) {
		my $x=scalar(@_)-1;
		$rc=$_[$x];
		#########################################################
		# Treat the last as an exit code - if it is numeric.	#
		#########################################################
		if($rc =~ /^\d+$/) {
			@_=@_[0 .. $x-1];
		} else {
			undef $rc;
		}
	}
	logit("error",@_);
	exit($rc) if defined($rc);
}

sub usage {
	print "
Usage: $::_PRG [--verbose|--quiet|--silent] [--no|--yes]
       $::_SPC [--timeout N]

The $::_PRG utility attempts to check the configuration databases
all nodes in the cluster to ensure that the data across the 
nodes is consistent, and if not, it attempts to work out a series
of corrections that might be performed to ensure that any 
inconsistencies found can be resolved to ensure the cluster
functions as expected in all situations.

At present only a limited set of command line arguments are supported:

--no       Do not make any changes; so acts as a 'preview' mode.
--yes      Make all changes suggested; recommended that the command
           is run with '--no' first to ensure administrator agrees
	   with the suggested alterations.
--timeout  The amount of time to wait for the cluster daemons to respond
           to requests. By default this is set to 10 seconds.
--verbose  Verbose mode - produce progress messages as changes take place.
--quiet    Quiet mode - only show warnings and errors.
--silent   Silent mode - only output generated is for fatal errors.

Written by Simon Edwards, (C) 2006-2008.
";
	exit 1;
}

sub confirm_add {
my $h_ref=shift;
my $key=shift;

	my $table=$h_ref->{$key}->{__TABLE__};
	my $nodes=join(",",@{$h_ref->{$key}->{__NODES__}});
	print "Add record to table '$table' on nodes '$nodes' ?\n";
	for my $cfield (sort(keys %{$h_ref->{$key}})) {
		next if($cfield eq "__TABLE__" || $cfield eq "__NODES__");
		print "      $cfield -> $h_ref->{$key}->{$cfield}\n";
	}
	print "Add record (Yes/No) ?";
	if($::ARG_yes) {
		print "Y\n";
		return 1;
	}
	if($::ARG_no) {
		print "N\n";
		return 0;
	}
	my $ans=<STDIN>;
	chomp $ans if defined($ans);
	if(defined($ans) && (uc($ans) eq "YES" || uc($ans) eq "Y")) {
		return 1;
	}
	return 0;
}

sub confirm_changes {
my $r_refs=shift;


	# Ok print out the changes just found ...
	my $x=1;
	for my $cref (@$r_refs) {
		my $table=$cref->[0];
		my $host=$cref->[1];
		my @keys=(@{$cref->[2]});
		my $x=sprintf("%2d :: Alter table '$table' for host '$host' for (" . join(",",@keys) . ") = (",$x);
		my @B=();
		push @B,$cref->[3]->{$_} foreach (@keys);
		$x.=join(",",@B) . ")";
		print "$x\n";
		for my $cfield (sort(keys (%{$cref->[3]}))) {
			next if grep {$cfield eq $_} @keys;
			print "      $cfield -> $cref->[3]->{$cfield}\n";
		}
		$x++;
	}
	print "Alter records (Yes/No) ?";
	if($::ARG_yes) {
		print "Y\n";
		return 1;
	}
	if($::ARG_no) {
		print "N\n";
		return 0;
	}
	my $ans=<STDIN>;
	chomp $ans if defined($ans);
	if(defined($ans) && (uc($ans) eq "YES" || uc($ans) eq "Y")) {
		return 1;
	}
	return 0;
}

$::ARG_timeout=10;
$::ARG_debug=0;
$::ARG_verbose=0;
$::ARG_quiet=0;
$::ARG_silent=0;
$::ARG_lwidth=$::_term_width;
$::ARG_no=0;
$::ARG_yes=0;

if(!GetOptions(
	"timeout=i"		=> \$::ARG_timeout,
	"verbose|V"		=> \$::ARG_verbose,
	"debug|D"		=> \$::ARG_debug,
	"quiet|Q"		=> \$::ARG_quiet,
	"silent|S"		=> \$::ARG_silent,
	"lwidth|W=i"		=> \$::ARG_lwidth,
	"yes"			=> \$::ARG_yes,
	"no"			=> \$::ARG_no,
	)) {
	usage;
}

if(defined($::ARG_lwidth)) {
	$::LOGGER=new cllogging("-",$::ARG_lwidth);
} else {
	$::LOGGER=new cllogging("-",80);
}

$::LOGGER->set_quiet;
$::LOGGER->set_debug if $::ARG_debug;
$::LOGGER->set_silent if $::ARG_silent;
$::LOGGER->set_quiet if $::ARG_quiet;
$::LOGGER->set_verbose if $::ARG_verbose;

#########################################################################
# Argument checking....							#
# [1] Check one at most of the yes/no options have been specified.	#
#########################################################################

if($::ARG_yes+$::ARG_no>1) {
	usage();
}

#########################################################################
# Attempt to communicate with all cluster nodes via the request		#
# daemons.								#
#########################################################################

{
	msg("Checking for available request daemons - please wait.");
	my ($_ok,$_dead)=get_clreqd_status($::ARG_timeout); 
	@::OK=(@$_ok); @::DEAD=(@$_dead);
	if(@::DEAD) {
		error("The following request daemons are not running:");
		error("* $_") foreach(@::DEAD);
		error("Aborting - consistency checker MUST communicate with all nodes.",1);
	}
	msg("All nodes successfully contacted.");
}

#########################################################################
# Work out whether the cluster is running or not.			#
#########################################################################

$::CLREQDXML=new clreqdxml("$::ENV{TRUECL_CFG}/clreqd.xml");
if(! defined($::CLREQDXML)) {
        error("Unable to load Request Daemon configuration info.", "Reason: " .  clreqdxml::error(),1);
}

$::MASTER=undef;
{
	my $rr=new clreq(hosts => [$::OK[0]], clreqdxml => $::CLREQDXML, logger => $::LOGGER, timeout => $::ARG_timeout);
	my $res=$rr->run(cmd => ["get_master_node"]);
	for (keys(%$res)) {
		if($res->{$_} =~ /^OK/) {
			$::MASTER=(split(/\s+/,$res->{$_}))[1];
		}
	}
}

if(!defined($::MASTER)) {
	msg("Cluster Status: DOWN");
} else {
	msg("Cluster Status: UP");
}

# Dealing with tables that should be identicial is the
# easiest ... so we loop around them first...
# If the contents are not identical we work out which are
# different, and if only a single node appears to have different
# records we attempt to indicate a correction to bring the table
# back into line.
# For the ports table just certain records need to be identical, 
# hence the reason for the more detailed entry in the following table.

%::identical_tables=(
	"nodes"	=> ["name","Node Configuration Table"],
	"applications" => ["name","Basic Application Configuration Table"],
	"application_ips" => ["name|network","Application IP Addressing Table"],
	"application_fs" => ["name|mountpnt","Application File System Table"],
	"application_routes" => ["appname|label","Application IP Route Checking Table"],
	"diskhb" => ["name|node","Disk Heartbeat Table"],
	"ports" => ["number","Port Allocation Table","detail",'^lha_.*d',"Cluster Daemon Ports"],
	"globals" => ["var","Global Configuration Settings","var",'^(bcast_threshold|formtime|interval|min_net_known_connections|starttimeout|stoptimeout|warntime|clustername|failtime|topology_check)$',"Shared Config Settings"],
    );

@::CHANGES=();
%::ADD=();
{
	my $REQD_UP=new clreq(hosts => [@::OK], clreqdxml => $::CLREQDXML, logger => $::LOGGER, timeout => $::ARG_timeout);
	my $local=hostname;
	my @others=grep {$_ ne $local} @::OK;
	for my $ctable (keys %::identical_tables) {
		my @keys=split(/\|/,$::identical_tables{$ctable}->[0]);
		my $desc=$::identical_tables{$ctable}->[1];
		my $partial=0;
		my $partial_field=undef;
		my $partial_match_pattern=undef;
		my $partial_description=undef;
		if(@{$::identical_tables{$ctable}} == 5) {
			$partial=1;
			$partial_field=$::identical_tables{$ctable}->[2];
			$partial_match_pattern=$::identical_tables{$ctable}->[3];
			$partial_description=$::identical_tables{$ctable}->[4];
			msg("Checking '$desc' [table = '$ctable' - $partial_description] ...");
		} else {
			msg("Checking '$desc' [table = '$ctable'] ...");
		}

		# Grab out all records from the table and convert to hashes
		my $s="SELECT * FROM $ctable ORDER BY " . join(",",@keys) . ";";
		my $res=$REQD_UP->run(cmd => ["perform_adhoc_sql","DBTYPE","config","SQL","$s"]);
		my $info=map_select_output($res);

		#################################################################################
		# If we are to perform just partial matches we scan the results and filter	#
		# out records that do not match.						#
		#################################################################################

		if($partial) {
			my %m=();
			for my $_cckey (keys %$info) {
				my $_cchost=$info->{$_cckey};
				my @matches=();
				for my $crec (@$_cchost) {
					if($crec->{$partial_field} =~ /$partial_match_pattern/) {
						push @matches,$crec;
					}
				}
				$m{$_cckey}=[@matches];
			}
			$info={%m};
		}

		# For localhost against the rest
		if(!exists($info->{$local})) {
			error("No details for host '$local' - eek!",1);
		}

		# We can also check for new records here and add to @::ADD
		# if necessary - and then delete the associated records
		# everywhere to! But how to do this...
		# [1] Take each local key, count locations present ... 
		#     if >1 th

		my $up_nodes=scalar(@::OK);
		my %all_keys=();
		my %all_keys2=();
		for my $cnode (keys %$info) {
			for my $crec (@{$info->{$cnode}}) {
				if(!ref($crec)) {
					next;
				}
				my $ckey="";
				my @ck=();
				push @ck,$crec->{$_} foreach (@keys);
				$ckey=join("|",@ck);
				if(!exists($all_keys{$ckey})) {
					$all_keys{$ckey}=[];
				}
				push @{$all_keys{$ckey}},$cnode;
				$all_keys2{$ckey}={%$crec};
			}
		}
		# Populate the ADD with all the information for the 
		# new records to add.
		for my $ckey (keys %all_keys) {
			if(scalar(@{$all_keys{$ckey}}) < $up_nodes) {
				my @n=();
				for my $cnode (@::OK) {
					if(! grep {$_ eq $cnode} @{$all_keys{$ckey}}) {
						push @n,$cnode;
					}
				}
				# We have the list nodes to add the record to,
				$::ADD{$ckey}={__NODES__ => [@n], __TABLE__ => $ctable,  %{$all_keys2{$ckey}}};
			}
		}
		my $count=scalar(@{$info->{$local}});
		my $xx;
		for($xx=0; $xx<$count; $xx++) {
			my %crecraw=();
			my %_crecraw=();
			my $raw="";
			if(ref($info->{$local}->[0])) {
				$raw.=$info->{$local}->[$xx]->{$_} foreach (sort(keys(%{$info->{$local}->[$xx]})));
			}
			$raw=unpack("h*",$raw);
			$_crecraw{sha1_hex($raw)}=[$local];
			$crecraw{$local}=$raw;
			my $diff=0;
			my $lref=$info->{$local}->[$xx];
			my %replace=();
			my $local_key="";
			if(ref($info->{$local}->[0])) {
				$local_key.=$info->{$local}->[$xx]->{$_} foreach (@keys);
			}
			for my $cnode (@others) {
				my $xx2;
				my $count2=scalar(@{$info->{$cnode}});
				for($xx2=0; $xx2<$count2; $xx2++) {
					my $cref=$info->{$cnode}->[$xx2];

					# Generate the current key value and 
					# ignore this record if not the same...

					my $cnode_key="";
					if(ref($cref)) {
						$cnode_key.=$cref->{$_} foreach (@keys);
					}
					next if $cnode_key ne $local_key;
					# Compare lref/cref ...
					$raw="";
					if(ref($info->{$cnode}->[$xx])) {
						$raw.=$info->{$cnode}->[$xx]->{$_} foreach (sort(keys(%{$info->{$cnode}->[$xx]})));
					}
					$raw=unpack("h*",$raw);
					my $_xx=sha1_hex($raw);
					if(!exists($_crecraw{$_xx})) {
						$_crecraw{$_xx}=[];
					}
					push @{$_crecraw{$_xx}},$cnode;
					$crecraw{$cnode}=$raw;
					$replace{$cnode}=[];
					next if !ref($cref);
					for my $ckey (keys %$cref) {
						if($lref->{$ckey} ne $cref->{$ckey}) {
							# Rather than simply recording the fact that they are 
							# different, we also record the differences...
							$diff=1;
							push @{$replace{$cnode}},$ckey;
						}
					}
				}
			}
			# If diff==1 then there are some differences in record [xx] 
			# of the current table. The crecraw keyed by hostname
			# can be used to point out differences
			if($diff) {
				warning("Differences found in record '$xx'.");
				my $max_count=0; my $max_key="";
				my $ok_host="";
				# If there is just a single host with differences then
				# we can suggest a simple fix, otherwise we simply
				# have to provide a 'consensus' option with may or may
				# not be the way to go!!!
				if(scalar(keys %_crecraw)>2) {
					my $x=scalar(keys %_crecraw);
					my @vv2=();
					push @vv2,$info->{$local}->[$xx]->{$_} foreach (@keys);
					my $vv=join(",",@vv2);
					warning("$x different records for found when '(" . join(",",@keys) . ")' == '($vv)' :");
					@vv2=();
					for my $_xxx (keys %{$info->{$local}->[$xx]}) {
						next if ! grep {$_ ne $_xxx} @keys;
						push @vv2,$_xxx;
					}

					warning("These are grouped as follows:");
					for my $ckey (sort(keys %_crecraw)) {
						my $h=$_crecraw{$ckey}->[0];
						my $str="";
						my @_str=();
						for my $_xxx (@vv2) {
							$str="$_xxx=='$info->{$h}->[$xx]->{$_xxx}'";
							push @_str,$str;
						}
						$str=join(",",@_str);
						warning("* " . join(",",@{$_crecraw{$ckey}}) . " : $str");
					}
				} else {
					# Work out which key has the most members...
					for my $ckey (sort(keys %_crecraw)) {
						if(scalar(@{$_crecraw{$ckey}}) > $max_count) {
							$max_key=$ckey;
							$max_count=scalar(@{$_crecraw{$ckey}});
							$ok_host=$_crecraw{$ckey}->[0];
						}
					}
					my @_changes=();
					for my $ckey (sort(keys %_crecraw)) {
						if($ckey ne $max_key) {
							for my $_chost (@{$_crecraw{$ckey}}) {
								my %replace2=();
								for my $cccc (@keys,@{$replace{$_chost}}) {
									$replace2{$cccc}=$info->{$ok_host}->[$xx]->{$cccc};
								}
								push @_changes,[$ctable,$_chost,[@keys],{%replace2}];
							}
						}
					}
					if( confirm_changes(\@_changes)) {
						push @::CHANGES,$_ foreach (@_changes); 
					}
				}
			}
		}
	}
}

# Handle any record adds necessary ....

if(scalar keys(%::ADD)) {
	for my $ckey (keys %::ADD) {
		my $add_it=confirm_add(\%::ADD,$ckey);
		my @f=grep {$_ ne "__NODES__" && $_ ne "__TABLE__"} keys(%{$::ADD{$ckey}});
		my $sql="INSERT INTO $::ADD{$ckey}->{__TABLE__} (" . join(",",@f) . ") VALUES (";
		my @FF=();
		for my $cf (@f) {
			push @FF,"'$::ADD{$ckey}->{$cf}'";
		}
		$sql.=join(",",@FF) . ");";
		my $reqd=new clreq(hosts => $::ADD{$ckey}->{__NODES__}, clreqdxml => $::CLREQDXML, logger => $::LOGGER, timeout => $::ARG_timeout);
		my $res=$reqd->run(cmd => ["perform_adhoc_sql","DBTYPE","config","SQL","$sql"]);
		for my $host (@{$::ADD{$ckey}->{__NODES__}}) {
			if(!defined($res) || !defined($res->{$host})) {
				error("Unable to run the following SQL on '$host':");
				error("$sql",1);
			}
			if($res->{$host} !~ /^OK/) {
				error("Error returned from attempting to correct record on '$host':");
				error("SQL: $sql");
				error($res->{$host},1);
			}
		}
	}
}

if(@::CHANGES) {
	my $x=1;
	for my $cref (@::CHANGES) {
		my $table=$cref->[0];
		my $host=$cref->[1];
		my @keys=(@{$cref->[2]});
		my $sql = "UPDATE $table SET ";
		my $x=sprintf("Altering table '$table' for host '$host' for (" . join(",",@keys) . ") = (",$x);
		my @B=();
		push @B,$cref->[3]->{$_} foreach (@keys);
		$x.=join(",",@B) . ")";
		msg($x);
		@B=();
		for my $cfield (sort(keys (%{$cref->[3]}))) {
			next if grep {$cfield eq $_} @keys;
			push @B,"$cfield = '$cref->[3]->{$cfield}'";
			msg("  $cfield -> $cref->[3]->{$cfield}");
		}
		$sql.=join(",",@B) . " WHERE ";
		@B=();
		for my $ckey (@keys) {
			push @B,"$ckey = '$cref->[3]->{$ckey}'";
		}
		$sql.=join(" AND ",@B);
		$x++;
		
		my $reqd=new clreq(hosts => [$host], clreqdxml => $::CLREQDXML, logger => $::LOGGER, timeout => $::ARG_timeout);
		my $res=$reqd->run(cmd => ["perform_adhoc_sql","DBTYPE","config","SQL","$sql"]);
		if(!defined($res) || !defined($res->{$host})) {
			error("Unable to run the following SQL on '$host':");
			error("$sql",1);
		}
		if($res->{$host} !~ /^OK/) {
			error("Error returned from attempting to correct record on '$host':");
			error("SQL: $sql");
			error($res->{$host},1);
		}
	}
	;
}

exit(0);
